home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / prlgbnc1.lha / Bench / sdda.pl < prev    next >
Text File  |  1990-08-02  |  12KB  |  323 lines
  1. % Sdda3        5-Oct-86 
  2. % For use on simulator
  3.  
  4. %% To do:  (look for '%%')
  5. %%    recursion - keep list of call procedures, ignore recursive calls
  6. %%           problem: doesn't work for typical procedure working on a list,
  7. %%             since the list is smaller (different) each time.
  8. %%        possible optimization: "recognize" base case & skip to it
  9. %%    follow atoms, g is 'any atom', all others unique,  does it work?
  10. %%    stats - write heapused, cputime to files (as comments)
  11. %%    worst_case - handle ground terms (copy unify, modify atomic)
  12. %%    handle disjunction - needs worst_case
  13. %%    add cuts where possible to save space
  14. %%    fill in rest of built-ins
  15. %%     how to handle op?
  16. %%    Handle assert/retract?  call?  (If given ground terms- ok, vars- no)
  17. %%        must have ground functor, definite number of args!
  18.  
  19. % Front end for simulator use
  20. main :-
  21.     do_sdda(test,A,B,C).
  22.  
  23. % Does the sdda on FileName, instantiates Exitmodes to list of exit modes,
  24. % ExitModes structure: [[Funtor/Arity, Activation, Exit], ... ],
  25. % e.g. [[a/2, [g,X], [g,g]]
  26. do_sdda(FileName, ExitModes, BackList, PredList) :-
  27.     %%see(FileName),
  28.     read_procedures(Procs, ExitModes, Entries),    % collect all procedures
  29.     %%seen,
  30.     write('Procedures '), nl, write_list(Procs), nl,
  31.     write('Entry points '), nl, write_list(Entries), nl,
  32.     (nonvar(ExitModes) ->                % Don't mention there
  33.         (write('Declared exit modes '), nl,     % aren't any
  34.          write_list(ExitModes), nl) ;
  35.         true),
  36.     entry_exit_modes_list(Procs, ExitModes, Entries),
  37.     write('Exit modes '), nl, write_list(ExitModes), nl.
  38.  
  39. %%%  !!! Hard code in read for test:
  40. %    sdda_entry(c(A,B,C)).
  41. %    a(X, Y).
  42. %    a(X, X).
  43. %    c(A,B,C) :- a(A,B).
  44.  
  45. read_procedures([[a/2,a(_109,_110),a(_148,_148)|_184],
  46.          [c/3,(c(_191,_192,_193):-a(_191,_192))|_238]|_239],
  47.          _68,[c(_76,_77,_78)|_102]) :- !.
  48.  
  49. % For each entry point in Entries do sdda, building Known, an unbound-tail list
  50. % Known structure: [[Name/Arity, ActivationModes, ExitModes], ...|_],
  51. % where ActivationModes and ExitModes are lists of variables and the atom 'g'.
  52. % 'g' represents a ground element and variables represent equivalence classes.
  53. entry_exit_modes_list(_, _, Entries) :-            % Done
  54.     var(Entries).
  55. entry_exit_modes_list(ProcList, Known, [Entry|Entries]) :-
  56.     Entry =.. [Functor|Act],        % Get functor/arity & activation
  57.     length(Act, Arity),            % from entry declaration
  58.     proc_exit_mode(ProcList, Known, [], Functor/Arity, Act, _),  % No invoc.
  59.     entry_exit_modes_list(ProcList, Known, Entries).
  60.  
  61. % Do sdda on procedure Functor/Arity, given activation mode Act.  Instantiates
  62. % Known to known exit modes and Act to exit modes for Functor/Arity under Act
  63. proc_exit_mode(_, _, _, Functor/Arity, Act, Exit) :-
  64.     built_in(Functor/Arity, Act, Exit).            % This is a built-in
  65. proc_exit_mode(_, Known, _, Functor/Arity, Act, Exit) :-
  66.     look_up_act([Functor/Arity, Act, Exit], Known).       % Already did this
  67. proc_exit_mode(ProcList, Known, Invocations, Functor/Arity, Act, Exit) :-
  68.     umember([Functor/Arity|Clauses], ProcList),    % Look up definition
  69.     dup(Clauses, ClausesCopy),            % Don't munge original 
  70.     clause_exit_modes_list(ProcList, Known, Invocations, 
  71.                    ClausesCopy, Act, Exits),
  72.     (Exits=[] -> fail ; true),               % didn't find any => fail
  73.     worst_case(Exits, Exit),            % assume the worst
  74.     dup(Act, ActCopy),                % Need copy because Body
  75.     add_to_list([Functor/Arity, ActCopy, Exit], Known).   % binds Act & Exit
  76. proc_exit_mode(_, Known, _, Functor/Arity, Act, Exit) :-
  77.     write('No such procedure at compile time '),
  78.     Activation=..[Functor|Act],
  79.     write(Activation), nl,
  80.     all_shared(Act, Exit),            % return worst possible - all shared 
  81.     add_to_list([Functor/Arity, Act, Exit], Known).
  82.  
  83. % Analyze all clauses for this procedure, instantiate Exits to all exit modes
  84. clause_exit_modes_list(_, _, _, Clauses, _, []) :-
  85.     var(Clauses), !.                   % No more clauses => done
  86. clause_exit_modes_list(ProcList, Known, Invocations, 
  87.                [Clause|Clauses], Act, Exits) :-
  88.     eqmember([Clause, Act], Invocations),         % This is a recursive 
  89.     write('skipping clause exit mode for '), 
  90.     write(Clause), write(' '), write(Act), nl,
  91.     clause_exit_modes_list(ProcList, Known, Invocations,    % call, ignore
  92.                    Clauses, Act, Exits).        % it
  93. clause_exit_modes_list(ProcList, Known, Invocations, 
  94.                [Clause|Clauses], Act, [Exit|Exits]) :-
  95.     dup(Act, Exit),                    % We'll bind Exit
  96.     clause_exit_mode(ProcList, Known, [[Clause, Act]|Invocations], 
  97.               Clause, Exit),            % Record invocation
  98.     clause_exit_modes_list(ProcList, Known, Invocations, 
  99.                         Clauses, Act, Exits).
  100. clause_exit_modes_list(ProcList, Known, Invocations, 
  101.                [Clause|Clauses], Act, Exits) :-     % Unify failed
  102.     clause_exit_modes_list(ProcList, Known, Invocations, 
  103.                    Clauses, Act, Exits).   
  104.  
  105. % Given activation modes for this clause, return its exit modes
  106. clause_exit_mode(ProcList, Known, Invocations, Clause, Act) :-
  107.     (Clause = ':-'(Head, Body) ; Clause=Head, Body=true),    % Decompose it
  108.     Head =.. [_|Args],                    % Bind the head
  109.     unify(Args, Act),                    % to activation
  110.     body_exit_mode(ProcList, Known, Invocations, Body).     % do the body
  111.  
  112. body_exit_mode(ProcList, Known, Invocations, ','(Goal, Goals)) :-  % Conjunction
  113.     body_exit_mode(ProcList, Known, Invocations, Goal),    % Do 1st
  114.     body_exit_mode(ProcList, Known, Invocations, Goals).    % & rest
  115. body_exit_mode(ProcList, Known, Invocation, Goal) :-
  116.     functor(Goal, Functor, Arity),
  117.     Goal =.. [Functor|Act],
  118.     proc_exit_mode(ProcList, Known, Invocation, Functor/Arity, Act, Exit),
  119.     unify(Act, Exit).    
  120.  
  121. % Unifies Left and Right with the special case that the atom 'g' matches
  122. % any atom (except [])
  123. unify(Left, Left) :- !.                % Try standard unify first
  124. unify(Left, g) :-                % else, is it special case
  125.     atomic(Left), !,            
  126.     \+ Left=[].
  127. unify(g, Right) :-                
  128.     atomic(Right), !,
  129.     \+ Right=[].
  130. unify([LeftHead|LeftTail], [RightHead|RightTail]) :-    % or list
  131.     !, unify(LeftHead, RightHead),
  132.     unify(LeftTail, RightTail).
  133. unify(Left, Right) :-                    % or structure
  134.     Left =.. [Functor|LeftArgs],
  135.     Right =.. [Functor|RightArgs],
  136.     unify(LeftArgs, RightArgs).
  137.     
  138. % Succeed if Left and Right are equivalent, i.e. they are the exact same 
  139. % with variables renamed
  140. equiv(Left, Right) :- 
  141.     equiv(Left, Right, _).
  142. equiv(Left, Right, _) :-        
  143.     Left==Right, !.            
  144. equiv(g, Right, _) :-        
  145.     atomic(Right), !,
  146.     \+ Right=[].            
  147. equiv(Left, g, _) :-
  148.     atomic(Left), !,
  149.     \+ Left=[].            
  150. equiv(Left, Right, Bindings) :-
  151.     var(Left), !,
  152.     var(Right), 
  153.     equiv_vars(Left, Right, Bindings).
  154. equiv(Left, Right, Bindings) :-
  155.     var(Right), !,
  156.     var(Left), 
  157.     equiv_vars(Left, Right, Bindings).
  158. equiv([LeftHead|LeftTail], [RightHead|RightTail], Bindings) :-
  159.     !, equiv(LeftHead, RightHead, Bindings),
  160.     equiv(LeftTail, RightTail, Bindings).
  161. equiv(Left, Right, Bindings) :-
  162.     Left=..[Functor|LeftArgs],
  163.     Right=..[Functor|RightArgs],
  164.     equiv(LeftArgs, RightArgs, Bindings).
  165.  
  166. equiv_vars(Left, Right, Bindings) :-
  167.     var(Bindings), !,
  168.     Bindings=[[Left, Right]|_].
  169. equiv_vars(Left, Right, [[AnyVar, AnyBinding]|_]) :-
  170.     Left==AnyVar, !,
  171.     Right==AnyBinding.
  172. equiv_vars(Left, Right, [[AnyVar, AnyBinding]|_]) :-
  173.     Right==AnyBinding, !,
  174.     Left==AnyVar.
  175. equiv_vars(Left, Right, [ _|Bindings]) :-
  176.     equiv_vars(Left, Right, Bindings).
  177.  
  178. % Make a copy of Orig with new vars.  Copy must be a variable.
  179. % E.g. dup([A,s(A,B),[B,C]], New) binds New to [X,s(X,Y),[Y,Z]]
  180. dup(Orig, Copy) :-
  181.     dup(Orig, Copy, _).
  182. dup(Orig, Copy, Bindings) :-
  183.     var(Orig), !,
  184.     dup_var(Orig, Copy, Bindings).
  185. dup(Orig, Orig, _) :-                % Atoms, including []
  186.     atomic(Orig), !.
  187. dup([OrigHead|OrigTail], [CopyHead|CopyTail], Bindings) :-
  188.     !, dup(OrigHead, CopyHead, Bindings),
  189.     dup(OrigTail, CopyTail, Bindings).
  190. dup(Orig, Copy, Bindings) :-
  191.     Orig=..[Functor|OrigArgs],
  192.     dup(OrigArgs, CopyArgs, Bindings),
  193.     Copy=..[Functor|CopyArgs].
  194.  
  195. dup_var(Orig, Copy, Bindings) :-
  196.     var(Bindings), !,
  197.     Bindings=[[Orig, Copy]|_].
  198. dup_var(Orig, Copy, [[AnyVar, Copy]|_]) :-
  199.     Orig==AnyVar, !.
  200. dup_var(Orig, Copy, [_|Bindings]) :-
  201.     dup_var(Orig, Copy, Bindings).
  202.  
  203. % ----- Built-ins ----- %
  204.  
  205. built_in(true/0, [], []).            % No change 
  206. built_in(fail/0, [], []).            % No change 
  207. built_in('='/2, [X, Y], [g, g]) :- 
  208.     (atomic(X) ; atomic(Y)).         % Ground both if either atomic
  209. built_in('='/2, [X, Y], [X, X]).        % else bind them 
  210. built_in(/('+',2), [X, Y], [X, Y]).        % No change 
  211. built_in(/('-',2), [X, Y], [X, Y]).        % No change 
  212. built_in(/('*',2), [X, Y], [X, Y]).        % No change 
  213. built_in(/('/',2), [X, Y], [X, Y]).        % No change 
  214. built_in(/('>=',2), [X, Y], [X, Y]).        % No change 
  215. built_in(/('<',2), [X, Y], [X, Y]).        % No change 
  216. built_in(is/2, [X, Y], [g, Y]).            % Ground result 
  217.  
  218. % ----- Utilities ----- %
  219.  
  220. worst_case([], _).                %% Doesn't work if any Exits
  221. worst_case([Exit|Exits], Worst) :-        %% fail to match, e.g.
  222.     unify(Exit, Worst),            %% [[s(1)], [f(1)]].
  223.     worst_case(Exits, Worst).
  224.  
  225. look_up_act(_, Known) :-
  226.     var(Known), 
  227.     !, fail.    
  228. look_up_act([Functor/Arity, Act, Exit], [[Functor/Arity, KnownAct, Exit]|_]) :-
  229.     equiv(Act, KnownAct).    
  230. look_up_act([Functor/Arity, Act, Exit], [_|Known]) :-
  231.     look_up_act([Functor/Arity, Act, Exit], Known).
  232.  
  233. all_shared(Act, Exit) :-            %% Wrong
  234.     unify(Act, _, VarModesList),
  235.     bind_all(_, VarModesList),
  236.     unify(Act, Exit, VarModesList).
  237.  
  238. bind_all(_, VarModesList) :-
  239.     var(VarModesList).
  240. bind_all(Mode, [[Var, Mode]|VarModesList]) :-
  241.     var(Mode),
  242.     bind_all(Mode, VarModesList).
  243. bind_all(Mode, [[_, _]|VarModesList]) :-
  244.     bind_all(Mode, VarModesList).
  245.  
  246.  
  247. % Adds Element to the tail of List, an unbound-tail list
  248. add_to_list(Element, List) :-
  249.     var(List),
  250.     List=[Element|_].
  251. add_to_list(Element, [_|List]) :-
  252.     add_to_list(Element, List).
  253.  
  254. % Membership relation for unbound-tail lists
  255. umember(_, List) :- 
  256.     var(List), !, fail.
  257. umember(Element, [Element|_]).
  258. umember(Element, [_|Tail]) :- umember(Element, Tail).
  259.  
  260. % Strict membership relation for unbound-tail lists
  261. sumember(_, List) :- 
  262.     var(List), !, fail.
  263. sumember(Element, [AnyElement|_]) :- Element==AnyElement.
  264. sumember(Element, [_|Tail]) :- sumember(Element, Tail).
  265.  
  266. % Membership relation for standard nil-tail lists
  267. member(X, [X|_]).
  268. member(X, [_|T]) :- member(X, T).
  269.  
  270. % Strict membership relation for standard nil-tail lists
  271. smember(X, [Y|_]) :- X==Y.
  272. smember(X, [_|T]) :- smember(X, T).
  273.  
  274. % Equiv membership relation for standard nil-tail lists
  275. eqmember(X, [Y|_]) :- equiv(X, Y).
  276. eqmember(X, [_|T]) :- eqmember(X, T).
  277.  
  278. % Our old favorite
  279. concat([], L, L).
  280. concat([X|L1], L2, [X|L3]) :- concat(L1, L2, L3).
  281.  
  282. % Pretty prints unbound-tail lists -- dies on NIL tail lists
  283. write_list(List) :-
  284.     dup(List, NewList),
  285.     (var(NewList) -> (name_vars(NewList, 0, _),
  286.               write(NewList)) ; 
  287.                  (write('['), 
  288.                     write_list2(NewList, 0, _), 
  289.                   write('|_].'))),     % write('].') to write nil tails
  290.     nl.                
  291. write_list2([H|T], NextName, NewNextName) :- 
  292.     name_vars(H, NextName, TempNextName),
  293.     write(H),
  294.     (nonvar(T) -> (write(','), nl, 
  295.                write(' '), 
  296.                write_list2(T, TempNextName, NewNextName)) ; 
  297.               NewNextName = TempNextName).
  298.  
  299. name_vars(Term, NextName, NewNextName) :-
  300.     var(Term), !,
  301.     make_name(NextName, Term),
  302.     NewNextName is NextName + 1.
  303. name_vars(Term, NextName, NextName) :-
  304.     atom(Term), !.
  305. name_vars([TermHead|TermTail], NextName, NewNextName) :-
  306.     !, name_vars(TermHead, NextName, TempNextName),
  307.     name_vars(TermTail, TempNextName, NewNextName).
  308. name_vars(Term, NextName, NewNextName) :-
  309.     Term =.. [_|TermArgs],
  310.     name_vars(TermArgs, NextName, NewNextName).
  311.  
  312. make_name(IntName, Variable) :-
  313.     Count is IntName // 26,
  314.     NewIntName is IntName mod 26 + "A",
  315.     build_name(Count, NewIntName, Name),
  316.     name(Variable, Name).
  317.  
  318. build_name(0, IntName, [IntName]) :- !.
  319. build_name(Count, IntName, [IntName|Rest]) :- Count>0,
  320.     NewCount is Count - 1,
  321.     build_name(NewCount, IntName, Rest).
  322.  
  323.